home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Toolbox classes / PopupMenu < prev    next >
Encoding:
Text File  |  1993-02-02  |  1.8 KB  |  96 lines  |  [TEXT/MSET]
  1. \ Class PopupMenu.  This version handles pop-up menus in dialogs.
  2. \ If we ever need one somewhere else, we'll have to define a subclass
  3. \ with different HIT: and NORMAL: methods.
  4.  
  5. need    dialog+
  6.  
  7. forward    DRAWBOX
  8.  
  9. :proc  PUboxProc
  10.     i->l  drawbox   ;proc
  11.  
  12. from PopUpMenuMod  import{  POPUPMENU  }
  13.  
  14. compile: PopUpMenuMod
  15.  
  16. objPtr    THEMENU  class_is  PopUpMenu
  17.  
  18. : FIND-MENU  { link item# -- b }
  19.     BEGIN
  20.         link nilP = IF  false  exit  then
  21.         link -> theMenu
  22.         box#: theMenu  item#  =  IF  true  EXIT  THEN
  23.         F-link: theMenu  -> link
  24.     AGAIN  ;
  25.  
  26. :f  DRAWBOX  { dlg-hdl item# -- }
  27.         \  Called from the PROC that handles the user item
  28.         \ for a pop-up box.
  29.         \ item# is is the DIALOG item#, not the menu item#.
  30.     dlg-hdl  find-dlg  0EXIT
  31.     PUM-link: this_dlg  item#  find-menu   0exit
  32.     drawbox: theMenu   ;f
  33.  
  34. \ endload
  35.  
  36. \ TESTING:
  37.  
  38. \        ========= Pop-up Menus ===========
  39.  
  40.     2    PopUpMenu    PU1
  41.     3    PopUpMenu    PU2
  42.     3    PopUpMenu    PU3
  43.  
  44.  
  45. : MMM    ." menu hit" cr  ;
  46. : NNN    ." another menu hit!!" cr  ;
  47.  
  48. CFAS(    mmm mmm        )  1 5 7 init: PU1
  49. CFAS(    mmm mmm mmm    )  2 6 8 init: PU2
  50. CFAS(    nnn nnn nnn    )  3 4 5 init: PU3
  51.  
  52. : HPU1    hit: pu1  ;
  53. : HPU2    hit: pu2  ;
  54. : HPU3    cr ." pu3 hit!!"  hit: pu3  ;
  55.  
  56.  
  57. \        ========= Dialog boxes =========
  58.  
  59.     6    dialog+    D1
  60.     4    dialog+    D2
  61.  
  62. : QQQ        20 beep  ;
  63. : WWW         1 beep  ;
  64. : ZZZ        ." useritem hit" cr  ;
  65.  
  66.  
  67. : CLOSE1    close: d1  ;
  68. : CLOSE2    close: d2  ;
  69.  
  70. CFAS(    qqq www close1 togitem hpu1 hpu2    )   300 init: d1
  71. CFAS(    qqq www close2 hpu3                    )   301 init: d2
  72.  
  73.  
  74. : GO
  75.     " PMtest.rsrc" openresfile
  76.  
  77. \ Set up dialogs:
  78.  
  79.     +modeless
  80.     getnew: d1  getnew: d2
  81.  
  82. \ Set up pop-up menus:
  83.  
  84.     getnew: pu1  getnew: pu2  getnew: pu3
  85.  
  86. \ This part has to be done after GetNew: on the dialog(s)
  87.  
  88.     d1 link: pu1
  89.     d1 link: pu2
  90.     d2 link: pu3  ;
  91.     
  92.  
  93. : zz
  94.     close: d1  close: d2  -modeless
  95.     clear: menubar  draw: menubar  ;
  96.